home *** CD-ROM | disk | FTP | other *** search
/ CD ROM Paradise Collection 4 / CD ROM Paradise Collection 4 1995 Nov.iso / program / swagd_f.zip / FILES.SWG / 0057_>64K Blockread-Blockwrite.pas < prev    next >
Pascal/Delphi Source File  |  1994-08-25  |  8KB  |  248 lines
  1. (*************************************************************************
  2.  
  3.            =====================================================
  4.            Breaking the 64K barrier for BlockRead and BlockWrite
  5.            =====================================================
  6.                  Copyright (c) 1992,1994 by José Campione
  7.                    Ottawa-Orleans Personal Systems Group
  8.                           Fidonet: 1:163/513.3
  9.  
  10.  Turbo Pascal implements two procedures for fast transfer of data from 
  11.  files to memory blocks and viceversa: Blockread and Blockwrite. One of 
  12.  the commonly encountered limitation in these procedures is the fact that 
  13.  they can only handle blocks not exceeding 65535 bytes.
  14.  
  15.  This limitation bears a connection with the often asked question on how 
  16.  to brake the 64K barrier for arrays declared in Pascal. Several answers 
  17.  have been proposed to this effect. Perhaps one of the most elegant is 
  18.  the one proposed by Neil Rubenking in his book on Turbo Pascal 6.0 
  19.  Techniques and Utilities (Ziff-Davis Press, 1991). Albeit elegant, 
  20.  Neil's approach uses OOP which may not be fully appreciated by many 
  21.  Pascal users. 
  22.  
  23.  So, here is a less ambitious approach with several procedures and 
  24.  functions permitting the direct handling of large memory blocks. In the 
  25.  following unit large memory blocks are defined as arrays of blocks each
  26.  not exceeding 64K. The only limitation for the size of the overall large 
  27.  block is that it must not exceed the normal RAM. A longint pointer is 
  28.  then used to access individual positions. 
  29.  
  30.  This unit uses a modified heapfunc that permits the replacement of "new" 
  31.  with "getmem". This, together with range checking off, allows an array 
  32.  to be declared as a single byte. During runtime it can be assigned any 
  33.  size determined by the program. This ensures that the "tail" of the big 
  34.  block will never be larger than strictly necessary. 
  35.  
  36.  Functions BigBlockRead and BigBlockWrite permit the reading and writing 
  37.  of blocks from and to a file much in the same way as Pascal's BlockRead
  38.  and BlockWrite. Only difference is that the 64K limit is not a problem 
  39.  anymore. Note that the size of the blocks can only be defined in terms 
  40.  of bytes and that the file being read or write must have been previously 
  41.  assigned to variable f (an untyped file declared within the unit). Also, 
  42.  these are not procedures but functions returning false if the reading or 
  43.  the writing of the big block was not completed. 
  44.  
  45.  In the present implementation only one array of big blocks is permitted. 
  46.  Variable BigBlkExist ensures that MakeBig will only work if a previous 
  47.  big block has not been created. BigBlk is the array of blocks reserved 
  48.  in the heap. SizBlk is an array containing the sizes in bytes of each 
  49.  block reserved in the heap as part of the big block. NumVec contains the
  50.  number of blocks used by the big block. 
  51.  
  52.  And last, some acknowledgements:
  53.  
  54.  Part of this unit was inspired by code contained in a file posted at 
  55.  garbo.uwasa.fi by Prof. Timo Salmi. The code itself was based on a 
  56.  submission by Naji Moawad. Prof. Salmi's code contained the following 
  57.  message: 
  58.  
  59.     The code below is based on a UseNet posting in comp.lang.pascal by 
  60.     Naji Mouawad nmouawad@watmath.waterloo.edu. Naji's idea was for a 
  61.     vector, my adaptation is for a two-dimensional matrix. The realization
  62.     of the idea is simpler than the one presented by Kent Porter in 
  63.     Dr.Dobb's Journal, March 1988. 
  64. ***************************************************************************)
  65.  
  66. {$R-} { R has to be off... }
  67. {$M 8096,0,655360}
  68.  
  69. unit bigarru;
  70.  
  71. interface
  72.  
  73.    uses crt,dos;
  74.  
  75.    const
  76.        SizVec = $FFFF;
  77.        MaxBlk = $FF;
  78.  
  79.    type
  80.        Vec = array [0..0] of byte;
  81.  
  82.    var
  83.        BigBlk  : array[0..MaxBlk] of ^Vec;
  84.        SizBlk  : array[0..MaxBlk] of word;
  85.        TotSizBlk : longint;
  86.        NumVec : byte;
  87.        HeapTop : pointer;
  88.        BigBlkExist : boolean;
  89.  
  90.    {$F+} function HeapFunc(Size: word) : integer; {$F-}
  91.    function MakeBig(HeapNeeded: longint): boolean;
  92.    function Peek(p: longint; var error: boolean): byte;
  93.    procedure Poke(b : byte; p: longint; var error: boolean);
  94.    procedure FillRange(fromby, toby :longint; b : byte);
  95.    procedure FillAll(b: byte);
  96.    function BigBlockRead (var f: file): boolean;
  97.    function BigBlockWrite(var f: file): boolean;
  98.  
  99. implementation
  100.  
  101.    {$F+} function HeapFunc(Size: word) : integer; {$F-}
  102.    begin
  103.      HeapFunc:= 1;
  104.    end;
  105.  
  106.    { Create the dynamic variables }
  107.    { HeapNeeded is the needed number of BYTES }
  108.    function MakeBig(HeapNeeded: longint): boolean;
  109.    var
  110.      i          : integer;
  111.      error      : boolean;
  112.    begin
  113.      error:= false;
  114.      if BigBlkExist then begin
  115.        Makebig:= false;
  116.        exit;
  117.      end;
  118.      fillchar(sizblk,sizeof(sizblk),0);
  119.      NumVec:= (HeapNeeded div SizVec);
  120.      if (HeapNeeded < SizVec) then begin
  121.        SizBlk[NumVec]:= HeapNeeded;
  122.        BigBlk[NumVec]:= nil;
  123.        GetMem(BigBlk[NumVec], SizBlk[NumVec]);
  124.        if BigBlk[NumVec] = nil then error:= true;
  125.      end else begin
  126.        i:= -1;
  127.        while not error and (i < NumVec - 1) do begin
  128.          inc(i,1);
  129.          SizBlk[i]:= SizVec;
  130.          BigBlk[i]:= nil;
  131.          GetMem(BigBlk[i],SizBlk[i]);
  132.          if BigBlk[i] = nil then error:= true;
  133.        end;
  134.        if not error then begin
  135.          SizBlk[NumVec]:= HeapNeeded - ((i + 1) * SizVec);
  136.          BigBlk[NumVec]:= nil;
  137.          GetMem(BigBlk[NumVec], SizBlk[NumVec]);
  138.          if BigBlk[NumVec] = nil then error:= true;
  139.        end;
  140.      end;
  141.      if not error then begin
  142.        TotSizBlk:= HeapNeeded;
  143.        BigBlkExist:= true;
  144.        MakeBig:= true;
  145.      end else begin
  146.        MakeBig:= false;
  147.        release(heaptop);
  148.      end;
  149.    end;  { makebig }
  150.  
  151.    function Peek(p: longint; var error: boolean): byte;
  152.    var
  153.      VecNum: byte;
  154.      BytNum: word;
  155.    begin
  156.      if BigBlkExist and not (p > totsizblk) then begin
  157.        error:= false;
  158.        VecNum:= p div SizVec;
  159.        BytNum:= p - (VecNum * SizVec);
  160.        peek:= BigBlk[VecNum]^[BytNum];
  161.      end else begin
  162.        error:= true;
  163.        peek:= 0;
  164.      end;
  165.    end;
  166.  
  167.    procedure Poke(b: byte; p: longint; var error: boolean);
  168.    var
  169.      VecNum: byte;
  170.      BytNum: word;
  171.    begin
  172.       if BigBlkExist and not (p > totsizblk) then begin
  173.         error:= false;
  174.         VecNum:= p div SizVec;
  175.         BytNum:= p - (VecNum * SizVec);
  176.         BigBlk[VecNum]^[BytNum]:= b;
  177.       end else error:= true;
  178.    end;
  179.  
  180.    procedure FillRange(fromby, toby :longint; b : byte);
  181.    var
  182.      p: longint;
  183.      VecNum: byte;
  184.      BytNum: word;
  185.    begin
  186.      If BigBlkExist then begin
  187.        for p:= fromby to toby do begin
  188.          VecNum:= p div SizVec;
  189.          BytNum:= p - (VecNum * SizVec);
  190.          BigBlk[VecNum]^[BytNum]:= b;
  191.        end;
  192.      end;
  193.    end;
  194.  
  195.    procedure FillAll(b: byte);
  196.    var
  197.      i : byte;
  198.    begin
  199.      if BigBlkExist then
  200.        for i:= 0 to NumVec do
  201.          fillchar(BigBlk[i]^,SizBlk[i],b);
  202.    end;
  203.  
  204.    function BigBlockRead (var f: file): boolean;
  205.    var
  206.      i : integer;
  207.      error : boolean;
  208.    begin
  209.      error:= false;
  210.      BigBlockRead:= true;
  211.      {$I-} reset(f,1); {$I+}
  212.      if (ioresult = 0) and bigblkexist then begin
  213.        i:= -1;
  214.        while not error and (i < NumVec) do begin
  215.          inc(i,1);
  216.          {$I-} BlockRead(f,BigBlk[i]^,SizBlk[i]); {$I+}
  217.          if ioresult <> 0 then error:= true;
  218.        end;
  219.        if not error then {$I-}close(f){$I+} else BigBlockRead:= false;
  220.      end else BigBlockRead:= false;
  221.    end;
  222.  
  223.    function BigBlockWrite(var f: file): boolean;
  224.    var
  225.      i : integer;
  226.      error : boolean;
  227.    begin
  228.      error:= false;
  229.      BigBlockWrite:= true;
  230.      {$I-} rewrite(f,1); {$I+}
  231.      if (ioresult = 0) and bigblkexist then begin
  232.        i:= -1;
  233.        while not error and (i < NumVec) do begin
  234.          inc(i,1);
  235.          {$I-} BlockWrite(f,BigBlk[i]^,SizBlk[i]); {$I+}
  236.          if ioresult <> 0 then error:= true;
  237.        end;
  238.        if not error then {$I-}close(f){$I+} else BigBlockWrite:= false;
  239.      end else BigBlockWrite:= false;
  240.    end;
  241.  
  242. begin
  243.   heaperror:= @heapfunc;
  244.   BigBlkExist:= false;
  245.   mark(heaptop);
  246. end.
  247.  
  248.